home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SAVESCRN.SWG / 0011_Save Dos Screen.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  2KB  |  95 lines
  1.  Program FancyWiper;
  2.  uses crt;
  3.  
  4.  Type
  5.    {I define the following type for all my virtual screens. Using this
  6.     record allows me to write to any screen variable very easily}
  7.    ScreenType = array [1..25,1..80] of record
  8.         ch   : Char;
  9.         Attr : Byte;
  10.       end;
  11.  
  12.  Var
  13.    {define a variable which points to the screen location. If you had a mono
  14.     card then the address would be $B000:0000.}
  15.    Screen : ScreenType absolute $B800:0000;
  16.  
  17.    {Declare a variable to save your old DOS screen}
  18.    OldScreen : ScreenType;
  19.    {Declare a virtual screen}
  20.    VirtScr : ScreenType;
  21.  
  22.    {This procedure is used to write text to a virtual screen. Now
  23.     there are no problems writing to line 25! ;-) }
  24.    Procedure MyWrite(var Scr : ScreenType; x,y : integer; st : String);
  25.    var
  26.      t, xpos : integer;
  27.    begin
  28.      xpos := 0;
  29.  
  30.      {exit proc if y not in screen limits}
  31.      if not (y in [1..25]) then
  32.        exit;
  33.  
  34.      while (xpos+1 <= length(st)) and (xpos+x <=80) do
  35.        begin
  36.          with Scr[y, xpos+x] do
  37.            begin
  38.              ch := St[xpos+1];
  39.              attr := TextAttr;
  40.            end;
  41.          inc(xpos);
  42.        end;
  43.    end;
  44.  
  45.    {A kludgy ClrScr for a virtual screen }
  46.    Procedure MyClrScr(var Scr : ScreenType);
  47.    begin
  48.      fillchar(Scr, Sizeof(scr), 0);
  49.    end;
  50.  
  51.    {Simple demonstration of a fancy effect. There's a lot more where this came
  52.    from!!}
  53.    Procedure Wipe(Scr : ScreenType; Left : Boolean; DelayTime : Word);
  54.    var
  55.      xstep,x,y : integer;
  56.    begin
  57.      if Left then
  58.        begin
  59.          xstep := -1;
  60.          x := 80;
  61.        end
  62.      else
  63.        begin
  64.          xstep := 1;
  65.          x := 1;
  66.        end;
  67.  
  68.      while x in [1..80] do
  69.        begin
  70.          for y := 1 to 25 do
  71.            Screen[y,x] := Scr[y,x];
  72.          Delay(DelayTime);
  73.          inc(x,xstep);
  74.        end;
  75.    end;
  76.  
  77.  
  78.  Begin
  79.    {Save the dos screen first}
  80.    OldScreen := Screen;
  81.  
  82.    {Now go and do whatever you want with the screen}
  83.    TextColor(Green);
  84.    MyClrScr(VirtScr);
  85.    MyWrite(VirtScr,10,10,'Hello there! Hows everything!  That should make this line long enough');
  86.    MyWrite(VirtScr,10,13,'Whats your name : ');
  87.    Wipe(VirtScr,True,30);
  88.    GotoXy(28,13);
  89.    TextColor(White);
  90.    Readln;
  91.  
  92.    {Now to restore the old screen}
  93.    Wipe(OldScreen,False,20);
  94.  End.
  95.